;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This program is free software.  You may run, copy, modify, and
;;; redistribute it under the terms of the GNU General Purpose License
;;; (GPL) version 3, or any later version.

;;; Generic functional fixpoint calculations

(define-module (derivative utils fix)
  #:use-module (derivative utils memoize)
  #:use-module (ice-9 vlist)
  #:export (graph-search
	    fix*))

(define* (graph-search proc #:optional reentry)
  "Return a procedure that is capable of \"searching\" a graph.  If a
node is re-entered, (REENTRY ARGS ...) is returned, otherwise (PROC
ARGS ...)."
  (let ((seen (make-parameter vlist-null)))
    (lambda args
      (let ((visited? (vhash-assoc args (seen))))
	(if visited?
	    (if reentry
		(apply reentry args)
		#t)
	    (parameterize ((seen
			    (vhash-cons args #t (seen))))
	      (apply proc args)))))))

(define (fix* bottom proc)
  (memoize
   (graph-search proc (const bottom))))
